Graphs & Networks
What’s new in 10

Charles Pooh

Manager, Discrete Computation
Wolfram Research

Graphs & Networks in Mathematica

spikey=;spikey10=;
text8={"150 functions","Modeling and analysis"};
text9={"205 functions","Modeling and analysis, Visualization, Social Networks"};
text10={"225 functions","More Modeling, More Analysis, More Visualization, Extensive domains of applications"};
spikeypos=16;
spikeysize=48;
textpos=32;
textposup=.12;
textposup2=-.09;
text1style={"Subtitle", White};
text2style={"Subtitle", GrayLevel[.9], 20};
labels=Pane[Style[#,"Subsection", GrayLevel[.2]], ImageSize->180]&/@{"Mathematica 8","Mathematica 9","Mathematica 10"};
BarChart[{260,170,100},ChartElementFunction->(Translate[ChartElementDataFunction["ArrowRectangle","ArrowWidth"->1,"TaperRatio"->.1,"ArrowheadAngle"->100][##],{15,0}]&),BarSpacing->1,BarOrigin->Left,ChartLabels->(Pane[Style[#,20], ImageSize->230]&/@{"Mathematica 8","Mathematica 9","Mathematica 10"}),Frame->{{True,None},{None,None}}, ImageSize->1300,PlotRange->{{0,320},{.665,3.335`}},FrameTicks->{{{{0.61,"",{.01,0}},{1,labels[[3]],.01},{2,labels[[2]],.01},{3,labels[[1]],.01},{3.39,"",{.01,0}}},None},{None,None}}, FrameStyle->Directive[Thickness[.0015],GrayLevel[.5]],ChartStyle->"DarkRainbow",Epilog->{Inset[Image[spikey10,ImageSize->spikeysize .9],{spikeypos,1},Left],Inset[Image[spikey,ImageSize->spikeysize],{spikeypos,2},Left],Inset[Image[spikey,ImageSize->spikeysize],{spikeypos,3},Left],Inset[Style[text10[[1]],text1style],{textpos,1+textposup},Left],Inset[Style[text9[[1]],text1style],{textpos,2+textposup},Left],Inset[Style[text8[[1]],text1style],{textpos,3+textposup},Left],
Inset[Style[text10[[2]],text2style],{textpos,1+textposup2},Left],Inset[Style[text9[[2]],text2style],{textpos,2+textposup2},Left],Inset[Style[text8[[2]],text2style],{textpos,3+textposup2},Left]}, AspectRatio->.45]

What’s new in 10

MouseOver

MouseOver

MouseOver

MouseOver

Multigraphs and Mixed Graphs

Graph[{1\[UndirectedEdge]2,2\[UndirectedEdge]3,3\[UndirectedEdge]1,3\[UndirectedEdge]1}]

MultigraphQ[%]

Graph[{1\[DirectedEdge]2,2\[UndirectedEdge]3,3\[DirectedEdge]1}]

MixedGraphQ[%]

Multigraphs and Mixed Graphs

Seven Bridges of Königsberg

Can the seven bridges of the city of Königsberg over the Pregel River all be traversed in a single trip without doubling back, with the additional requirement that the trip ends in the same place it began?

bridges=;

No.

EulerianGraphQ[bridges]

3D Graph Visualization

DynamicModule[{mesh,start,end,linear,vfunc,rot,ti,t},Row[{Dynamic[ti=Sin[Clock[{0,Pi},18]];t=-2(1- ti )+ 5.5ti;Spacer[0]],With[{start=start,end=end},Dynamic@Show[{Piecewise[{{Graphics3D[GraphicsComplex[linear[start,end,0],{Hue[0.6,0.2,0.8],Line[List@@@EdgeList[mesh]],Hue[0.6,0.6,1],vfunc[t,linear[start,end,0],.1]}]],t<0},{Graphics3D[GraphicsComplex[rot[t,linear[start,end,t/3]],{Hue[0.6,0.2,0.8],Tube[List@@@EdgeList[mesh],linear[0.005,0.04,t/3]],Hue[0.6,0.6,1],vfunc[t,rot[t,linear[start,end,t/3]],.1]}]],t>=0&&t<3},{Graphics3D[GraphicsComplex[rot[t,linear[start,end,1]],{Hue[0.6,0.2,0.8],Tube[List@@@EdgeList[mesh],.04],Hue[0.6,0.6,1],vfunc[t,rot[t,linear[start,end,1]],.1]}]],t>=3&&t<5},{Graph3D[mesh,VertexCoordinates->rot[5,linear[start,end,1]]],t>=5}}]},Lighting->{{"Directional", 
      GrayLevel[0.7], 
      ImageScaled[{1, 1, 0}]}, {"Point", 
      GrayLevel[0.9], 
      ImageScaled[{0, 0, 0}], {0, 0, 0.07}}}, Boxed->False, PlotRange->{{-.2,9.3},{-.5,9.3},{-.5,8}}, ImageSize->500]]}],
Initialization:>(vfunc[t_/;t<.02, x_,r_]:=Cylinder[{#,#+{0,0,0.0001}}&/@x,r];
vfunc[t_,x_,r_]:=Sphere[x, r];linear[x_,y_,t_]:=(1-t) x + t y;mesh=Graph3D[Range[VertexCount[#]],#//EdgeList,DirectedEdges->False,GraphLayout->"SpringElectricalEmbedding"]&[PolyhedronData["GreatRhombicosidodecahedron","SkeletonGraph"]];start={#1,#2,0}&@@@GraphEmbedding[mesh];end=GraphEmbedding[mesh];rot=Compile[{{t,_Real},{p,_Real,1}},Module[{x,y,z},
{x,y,z}=p;{1.` (3.921906370381498` -3.921906370381498` Cos[0.6283185307179586` t]+1.` x Cos[0.6283185307179586` t]+3.8362332236931964` Sin[0.6283185307179586` t]-1.` y Sin[0.6283185307179586` t]),1.` (3.8362332236931964` -3.8362332236931964` Cos[0.6283185307179586` t]+1.` y Cos[0.6283185307179586` t]-3.921906370381498` Sin[0.6283185307179586` t]+1.` x Sin[0.6283185307179586` t]),1.` z}], RuntimeAttributes->Listable])
]

3D Graph Visualization

graphs={
KaryTree[40,5, EdgeShapeFunction->(Tube[#1,.03]&), VertexSize->.3],
Graph[{1\[UndirectedEdge]4,1\[UndirectedEdge]5,2\[UndirectedEdge]4,2\[UndirectedEdge]6,3\[UndirectedEdge]4,3\[UndirectedEdge]7,4\[UndirectedEdge]8,5\[UndirectedEdge]8,6\[UndirectedEdge]8,7\[UndirectedEdge]8},EdgeShapeFunction->(Tube[#1,.01]&)],
CompleteGraph[{3,3,2},VertexSize->.1,EdgeShapeFunction->(Tube[#1,.01]&)],
PathGraph[Range[25]],
GridGraph[{5,5},VertexSize->.3,EdgeShapeFunction->(Tube[#1,.03]&)],
Graph[{1\[DirectedEdge]3,1\[DirectedEdge]6,2\[DirectedEdge]6,3\[DirectedEdge]8,4\[DirectedEdge]2,4\[DirectedEdge]3,5\[DirectedEdge]1,5\[DirectedEdge]2,5\[DirectedEdge]7,6\[DirectedEdge]3,7\[DirectedEdge]6,8\[DirectedEdge]5,8\[DirectedEdge]7}],
Graph[GraphData[{"CrossedPrism",8},"EdgeList"],VertexSize->.2],
Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,1\[UndirectedEdge]5,2\[UndirectedEdge]4,2\[UndirectedEdge]6,3\[UndirectedEdge]4,3\[UndirectedEdge]7,4\[UndirectedEdge]8,5\[UndirectedEdge]6,5\[UndirectedEdge]7,6\[UndirectedEdge]8,7\[UndirectedEdge]8},VertexSize->.3,EdgeShapeFunction->(Tube[#1,.05]&)],
Graph3D[Range[20],{1\[UndirectedEdge]14,1\[UndirectedEdge]15,1\[UndirectedEdge]16,2\[UndirectedEdge]5,2\[UndirectedEdge]6,2\[UndirectedEdge]13,3\[UndirectedEdge]7,3\[UndirectedEdge]14,3\[UndirectedEdge]19,4\[UndirectedEdge]8,4\[UndirectedEdge]15,4\[UndirectedEdge]20,5\[UndirectedEdge]11,5\[UndirectedEdge]19,6\[UndirectedEdge]12,6\[UndirectedEdge]20,7\[UndirectedEdge]11,7\[UndirectedEdge]16,8\[UndirectedEdge]12,8\[UndirectedEdge]16,9\[UndirectedEdge]10,9\[UndirectedEdge]14,9\[UndirectedEdge]17,10\[UndirectedEdge]15,10\[UndirectedEdge]18,11\[UndirectedEdge]12,13\[UndirectedEdge]17,13\[UndirectedEdge]18,17\[UndirectedEdge]19,18\[UndirectedEdge]20}],
StarGraph[12,VertexSize->.15],
PathGraph[Range[25],VertexSize->.3],
Graph[Table[j->FromDigits[Drop[IntegerDigits[j,2],-1],2],{j,1,50}],VertexSize->.5,EdgeShapeFunction->(Tube[#1,.03]&)],
GridGraph[{5,6},GraphLayout->"HighDimensionalEmbedding",VertexSize->.25],
GridGraph[{4,6},GraphLayout->"SpectralEmbedding",VertexSize->.4],
KaryTree[10,3],
Graph[Range[9],{1\[UndirectedEdge]4,1\[UndirectedEdge]9,2\[UndirectedEdge]5,3\[UndirectedEdge]4,3\[UndirectedEdge]5,4\[UndirectedEdge]6,4\[UndirectedEdge]7,4\[UndirectedEdge]8,5\[UndirectedEdge]7},GraphLayout->{"MultipartiteEmbedding", "VertexPartition"->{3,2,4}},EdgeShapeFunction->(Tube[#1,.01]&)]
};
layouts={"BalloonEmbedding","BipartiteEmbedding",{"CircularMultipartiteEmbedding","VertexPartition"->{3,3,2}},"DiscreteSpiralEmbedding","TutteEmbedding","LayeredDigraphEmbedding","SpringElectricalEmbedding","PlanarEmbedding","SpringEmbedding","StarEmbedding","SpiralEmbedding","RadialEmbedding","HighDimensionalEmbedding","SpectralEmbedding","LayeredEmbedding",{"MultipartiteEmbedding", "VertexPartition"->{3,2,4}}};
background={Hue[.15,.3,.9],Hue[.7,.1,.7],Hue[.15,.2,.9],Hue[.2,.2,.7],Hue[.15,.2,.9],Hue[.5,.8,.7],Hue[.15,.5,.7],Hue[.5,.3,.7],Hue[.2,.3,.8],Hue[.15,.2,.8],Hue[.13,.2,.95],Hue[.2,.3,.5]};
fcolor=GrayLevel[.2];
label[{name_,__}]:=Style[name,Directive[11,fcolor,FontFamily->"Helvetica"]];
label[name_]:=Style[name,Directive[11,fcolor,FontFamily->"Helvetica"]];
GraphFrame3D[expr_,layout_,opts:OptionsPattern[]]:=
Framed[Labeled[Graph3D[VertexList[expr],EdgeList[expr],opts,DeleteCases[Options[expr],GraphLayout->_],{ GraphLayout->layout,ImageSize->{150,150},EdgeShapeFunction->(Tube[#1,.025]&), VertexSize->.2}],label[layout],Top,FrameMargins->{{0,0},{-5,0}}],FrameStyle->Directive[Thickness[4],fcolor],RoundingRadius->5];
Grid[Partition[Item[GraphFrame3D[#1,#2,  GraphStyle->"BasicBlue"]]&@@@Transpose[{graphs,layouts}][[{9,11,7,13,14,10,1,12,15,2,3,16,4,5,6,8}]],4,4,1,{}]]

Higher–Dimensional Layouts

Draw graphs in higher dimensions.

Obtain the four-dimensional coordinate of hypercube graph (Subscript[Q, 4]):

graph=HypercubeGraph[4];

coords=GraphEmbedding[graph,"SpringElectricalEmbedding",4];

Draw graphs with different projections.

proj1[{x_,y_,z_,w_}]:={Sqrt[3]*(z/2+w/6),y+1/2*(z+w),Sqrt[6]*w/3}

proj2[{x_,y_,z_,w_}]:=2(Sqrt[9]/(Sqrt[9]-w)){x,y,z}/4

Table[Graph3D[graph,VertexCoordinates->(p /@ coords)],{p,{proj1,proj2}}]

Graph & Network Capabilities

Constructors & Operations

FindSpanningTree — find a spanning tree (or spanning forest) of a graph

VertexContract ▫ EdgeContract ▫ LinkRankCentrality

Paths & Connectivity

FindPath — find all paths between two vertices

FindVertexIndependentPaths ▫ FindEdgeIndependentPaths

KVertexConnectedComponents ▫ KEdgeConnectedComponents ▫ KVertexConnectedGraphQ ▫ KEdgeConnectedGraphQ

Tours & Cycles

FindShortestTour — new and improved capabilities for tours and cycles

FindCycle — find all cycles

FindFundamentalCycles ▫ EdgeCycleMatrix

Isomorphisms

FindGraphIsomorphism — find several isomorphism mappings between graphs

GraphAutomorphismGroup — the group of all ways to remap vertex indexes

CanonicalGraph — canonical form for graphs

Relations

TransitiveClosureGraph — the transitive closure or reachability graph

TransitiveReductionGraph — the transitive reduction or Hasse diagram

Polynomials

TuttePolynomial — new graph polynomials

ChromaticPolynomial ▫ FlowPolynomial

Maze Generation

Create a maze generator in Mathematica 10.

g=GridGraph[{20,30},EdgeWeight->RandomReal[10,1150]];

tree=FindSpanningTree[{g,1}];

(*custom styling*)style={Background->GrayLevel[0],BaseStyle->{Directive[White,EdgeForm[],Opacity[1]]},VertexShapeFunction->(Rectangle[#1+.16,#1-.16]&),EdgeShapeFunction->(Rectangle[#1[[1]]+.16,#1[[2]]-.16]&)};
embedding=GraphEmbedding[GridGraph[{20,30}]];

maze=Graph[tree,VertexCoordinates->GraphEmbedding[g],style]

Solve the maze and highlight the path.

HighlightGraph[maze,PathGraph[FindShortestPath[maze, 1, 600]]]   ]

US Electric grid network

NPR series on power hungry: reinventing the u.s. electric grid.

pic=;

r=ImageAdjust[ColorConvert[ColorQuantize[ColorNegate[pic],3],"GrayLevel"]]

geo=GeoGraphics[{EdgeForm[Directive[Thick,]],FaceForm[None],Polygon[(Entity["United States", Entity["Country","UnitedStates"], "Entity[\"Country\", \"UnitedStates\"]", "country"])]},GeoRangePadding->{Scaled[0.7],0},ImageSize->500]

grid=MorphologicalGraph[r,ImagePadding->{{25,14},{32,20}},ImageSize->{390,390}, VertexShapeFunction->None,EdgeShapeFunction->({CapForm["Butt"],Line[#1]}&),Prolog-> Inset[geo,Offset[{-18,-10},{435,269}]]]

Major high-capacity electric transmission lines of the US electric grid form a disconnected network with two major sectors — eastern sector and western sector.

Robust subgrids that can sustain failures of two transmission lines.

{eastern,western}=Subgraph[grid,#]& /@ Take[ConnectedComponents[grid],2];

HighlightGraph[grid, {Style[Subgraph[grid,First[KEdgeConnectedComponents[eastern,2]]],,Thick],Style[Subgraph[grid,First[KEdgeConnectedComponents[western,2]]],,Thick]}]

Enhanced Performance and Usability

Usability

∘ GraphUtlities and Combinatorica (graph theory functionality) are now obsolete [compatibility page][ref page]

∘ More efficient graph rendering modules

Performance

∘ State-of-the-art solver for the traveling salesman problem

∘ Enhanced graph drawing

∘ Fastest graph algorithms

Tour of the World

Plan a tour through every country in the world.

countries=CountryData["Countries"];

FindShortestTour[GeoPosition /@ countries]//Shallow

countries[[Last[%]]]//Shallow

Visualize the tour.

Button[Show[,ImageSize->{100,100}],SystemOpen["/Users/charlesp/Desktop/WTC 2014/Files/Video/worldtour.mov"],Appearance->None]

TSP Art

Wolfram Art – SW

wolfram =;

wpts=ImageValuePositions[wolfram,Black];

res=FindShortestTour[wpts];//AbsoluteTiming

Graphics[Line[wpts[[res[[2]]]]]]

Da Vinci Art – Mona Lisa

monafile="http://www.math.uwaterloo.ca/tsp/data/ml/mona-lisa100K.tsp";

monalisa=Cases[Import[monafile,"Table"],{_Integer,x_?NumericQ,y_?NumericQ}:>{x,y}];

AbsoluteTiming[res=FindShortestTour[monalisa];]

Graphics[Line[monalisa[[res[[2]]]]]]

Summary

MouseOver

MouseOver

MouseOver

MouseOver

Resources

Marketing pages [web]

New Features [page]

Thank you …

ImageCollage[{,,,}]